home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xm / radio < prev    next >
Encoding:
Text File  |  1992-10-01  |  1.6 KB  |  70 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Radio box and button demo
  4.  
  5. (require 'motif)
  6. (load-widgets shell row-column arrow-button push-button toggle-button)
  7. (load 'radio-stuff)
  8.  
  9. (define top (application-initialize 'radio))
  10.  
  11. (define rc (create-managed-widget (find-class 'row-column) top))
  12.  
  13.  
  14. ;;; Create a button box containing arrow buttons; add callbacks
  15. ;;; to each button:
  16.  
  17. (define box1 (create-radio-box 'arrow-button rc))
  18.  
  19. (define buttons1
  20.   (map (lambda (dir)
  21.      (radio-box-add-button! box1 'width 50 'height 30
  22.                 'arrow-direction dir))
  23.        '(arrow_up arrow_down arrow_left arrow_right)))
  24.  
  25. (for-each
  26.   (lambda (w)
  27.     (for-each
  28.       (lambda (cb)
  29.         (add-callback w cb
  30.       (lambda (w r)
  31.         (print (list w (car r))))))
  32.     '(activate-callback arm-callback disarm-callback)))
  33.   buttons1)
  34.  
  35. ;;; Create a button box containing push buttons; define an
  36. ;;; entry callback:
  37.  
  38. (define box2 (create-radio-box 'push-button rc))
  39.  
  40. (add-callback box2 'entry-callback
  41.          (lambda (w args)
  42.            (print (car (get-values (caddr args) 'label-string)))))
  43.  
  44. (define buttons2
  45.   (map (lambda (label)
  46.      (radio-box-add-button! box2 'label-string label
  47.                 'alignment "alignment_center"))
  48.        '(Play Stop Record Rewind Forward)))
  49.  
  50.  
  51. ;;; Create a button box containing toggle buttons; add a callback
  52. ;;; to each button:
  53.  
  54. (define box3 (create-radio-box 'toggle-button rc))
  55.  
  56. (define buttons3
  57.   (map (lambda (label)
  58.      (radio-box-add-button! box3 'label-string label))
  59.        '(KMQX WMQY WHFX KMYC)))
  60.  
  61. (for-each
  62.   (lambda (w)
  63.     (add-callback w 'value-changed-callback
  64.           (lambda r (print (get-values w 'label-string 'set)))))
  65.   buttons3)
  66.  
  67.  
  68. (realize-widget top)
  69. (context-main-loop (widget-context top))
  70.